UFO Sightings

Data Wrangling

I got the data from a Kaggle website ( https://www.kaggle.com/NUFORC/ufo-sightings ) It contains a dataset of 80332 ufo sightings across the world collected over the last century.

Inspect Data

ufos_raw <- read_csv("ufos-scrubbed.csv") %>% 
  filter(country == "us")
head(ufos_raw) %>% kable("html")

datetime	city	state	country	shape	duration (seconds)	duration (hours/min)	comments	date posted	latitude	longitude
10/10/1949 20:30	san marcos	tx	us	cylinder	2700	45 minutes	This event took place in early fall around 1949-50. It occurred after a Boy Scout meeting in the Baptist Church. The Baptist Church sit	4/27/2004	29.88306	-97.94111
10/10/1956 21:00	edna	tx	us	circle	20	1/2 hour	My older brother and twin sister were leaving the only Edna theater at about 9 PM&#44…we had our bikes and I took a different route home	1/17/2004	28.97833	-96.64583
10/10/1960 20:00	kaneohe	hi	us	light	900	15 minutes	AS a Marine 1st Lt. flying an FJ4B fighter/attack aircraft on a solo night exercise&#44 I was at 50&#44000&#39 in a "clean" aircraft (no ordinan	1/22/2004	21.41806	-157.80361
10/10/1961 19:00	bristol	tn	us	sphere	300	5 minutes	My father is now 89 my brother 52 the girl with us now 51 myself 49 and the other fellow which worked with my father if he&#39s still livi	4/27/2007	36.59500	-82.18889
10/10/1965 23:45	norwalk	ct	us	disk	1200	20 minutes	A bright orange color changing to reddish color disk/saucer was observed hovering above power transmission lines.	10/2/1999	41.11750	-73.40833
10/10/1966 20:00	pell city	al	us	disk	180	3 minutes	Strobe Lighted disk shape object observed close&#44 at low speeds&#44 and low altitude in Oct 1966 in Pell City Alabama	3/19/2009	33.58611	-86.28611

Data prepping

-Text wrap comments column so that hover visualization shows multi-line output

-Coerce datetime into date format and extract Year & Year/Month as a new columns.

#Data transformation
ufos_raw$comments <- str_wrap(ufos_raw$comments, 50)
ufos_raw$year <-format(as.Date(ufos_raw$datetime,format="%m/%d/%Y"),"%Y")
ufos_raw$month <-format(as.Date(ufos_raw$datetime,format="%m/%d/%Y"),"%Y/%m")

Filter down data to just the columns we need for visualization.

#Select just the data needed
ufos <- ufos_raw %>% 
  filter(year >= '2000') %>% 
  select(c(datetime, latitude, longitude, month, comments, state, city, year, shape))
head(ufos) %>% kable("html")

datetime	latitude	longitude	month	comments	state	city	year	shape
10/10/2000 03:00	37.72417	-89.86111	2000/10	The craft was big&#44 orange&#44 and oval shaped.	mo	perryville	2000	oval
10/10/2000 06:15	26.52500	-80.06667	2000/10	Unusual light formation moving extremely fast across the sky.	fl	boynton beach	2000	other
10/10/2000 20:30	38.12667	-92.08444	2000/10	3 bright golden lights moving independently above the tree line flaring and fading intermittently for approx. 15 min.	mo	brinktown	2000	light
10/10/2000 21:30	38.99889	-84.62667	2000/10	Two objects traveling side by side pass over&#44 as one begins to zig&#44 zag it&#39s path.	ky	florence	2000	light
10/10/2000 21:30	47.60639	-122.33083	2000/10	Dark object in the shape of a (4) after dusk in West Seattle	wa	seattle (west)	2000	unknown
10/10/2000 22:00	47.54056	-122.63500	2000/10	One night my window started to flash	wa	port orchard	2000	diamond

Plot of UFOs sightings animated from the year 2000 onwards

ufos %>% 
  plot_mapbox(frame = ~month) %>% #frame creates animation
  layout(
    mapbox = list(
      style = "dark", #changes map style
      zoom = 2.4, 
      center = list(lat = 37, lon = -95) #centers on USA
    )
  ) %>% 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 3, color = "#FFFFCC", opacity = 0.4), #creates glyph aesthetic
  ) %>% 
  animation_opts(100) #sets the number of milliseconds per frame 

Plot of UFO sightings cumulative from 2000.

ufos1 <- ufos %>% 
  plot_mapbox() %>% 
  layout(
    mapbox = list(
      style = "dark", 
      zoom = 2.4, 
      center = list(lat = 37, lon = -95)
    )
  ) %>% 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 2, color = "#FFFFCC", opacity = 0.2),
    text = ~paste("<b>Date/Time:</b>", datetime,"<br><b>Report:</b>", comments, "<br><b>City/State:</b>", city, ",", state),
    textposition = "auto",
    hoverlabel = list(align = "left"),
    hoverinfo = "text"
  ) 

ufos1

Reflection

I was quite frustrated about the animation. There were moments when the animation would jitter crazily when I made the frame rate higher. In order to make the animation smoother, I had to cut down the number of years it scrubbed through as well as lower the frame rate. Lots of tweaking to figure out what works.

I implemented the use of color and lightness in Wilke’s book to convey density in geospatial data. Since UFOs are often seen at night, I made the map background dark, and used light glyphs to emphasize higher intensity/concentration of sightings.

The story I am telling through this visualization is the increasing number and concentration of UFO sighting reports across the years. The animation and visualization also helps us see concentrations of regions that report sightings regularly.

Improvements

I took Tom Takeuchi’s idea of using crosstalk to create a multi-select bar for the plot, which selects years.

library(crosstalk)

ufos2 <- highlight_key(ufos, ~year)

widgets <- bscols(
  filter_select("Select a Year", "Select a Year", ufos2, ~year)
)

bscols(widths = c(3,9), widgets,
  ufos2 %>% 
  plot_mapbox() %>% 
  layout(
    mapbox = list(
      style = "dark", 
      zoom = 2.4, 
      center = list(lat = 37, lon = -95)
    )
  ) %>% 
  add_markers(
    x = ~longitude, 
    y = ~latitude,
    marker = list(size = 2, color = "#FFFFCC", opacity = 0.2),
    text = ~paste("<b>Date/Time:</b>", datetime,"<br><b>Report:</b>", comments, "<br><b>City/State:</b>", city, ",", state),
    textposition = "auto",
    hoverlabel = list(align = "left"),
    hoverinfo = "text"
  ) 
)

Select a Year